How Skin Tone Emojis and Profile Pictures Shape Attention and Social Inference Processing
Author
S.P.
Published
6 November 2024
Information About the R Session
sessionInfo()
R version 4.3.2 (2023-10-31)
Platform: aarch64-apple-darwin20 (64-bit)
Running under: macOS 15.1
Matrix products: default
BLAS: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.11.0
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
time zone: Europe/Amsterdam
tzcode source: internal
attached base packages:
[1] stats graphics grDevices utils datasets methods base
loaded via a namespace (and not attached):
[1] htmlwidgets_1.6.4 compiler_4.3.2 fastmap_1.2.0 cli_3.6.2
[5] tools_4.3.2 htmltools_0.5.7 rstudioapi_0.16.0 yaml_2.3.8
[9] rmarkdown_2.25 knitr_1.45 jsonlite_1.8.8 xfun_0.41
[13] digest_0.6.34 rlang_1.1.3 evaluate_0.23
Set Up
# Set the working directory to the current folder (uncomment)#setwd(dirname(rstudioapi::getActiveDocumentContext()$path))# Load packageslist.of.packages <-c("qualtRics", # Read files obtained through Qualtrics"readr", # Write csv files"dplyr", # Manipulate data during preprocessing"tidyr", # Manipulate data during preprocessing"stringr", # Manipulate strings during preprocessing"janitor", # Clean and manage data during preprocessing"ggplot2", # Create plots"ggfx", # Add drop shadow effect on elements in a plot"sur", # Generate descriptive tables"vtable", # Generate descriptive tables"packHV", # Generate descriptive plots"psych", # Conduct reliability tests"rstatix", # Identify outliers"performance", # Compare models"car", # Analyze Variance Inflation Factor (VIF)"ordinal", # Execute Cumulative Link Mixed Models (CLMM)"RVAideMemoire", # Test CLMM models"emmeans", # Perform contrast analysis"lme4", # Run Linear Mixed Models"kableExtra", # Display tables in HTML format"sjPlot", # Generate advanced tables for models"report", # Generate advanced reporting for linear models"Hmisc", # Generate advanced reporting for cumulative models"DHARMa", # Create residuals for models"glmmTMB", # Run models with Gamma family"gamlss", # Fit relevant parametric distributions"effectsize", # Calculate and convert effect sizes"nortest", # Run the Anderson-Darling test for normality"parameters"# Calculate confidence intervals for contrasts )new.packages <- list.of.packages[!(list.of.packages %in%installed.packages()[, "Package"])]if (length(new.packages))install.packages(new.packages) # Install any new packageslapply(list.of.packages, require, character.only =TRUE) # Library in all packagesrm(list.of.packages, new.packages)# Remove scientific notationoptions(scipen =999)options("width"=900)
## Check if all participants viewed both target and filler conversationsx_fillers_count <- dfet %>% dplyr::select("id", "filler") %>%group_by(id, filler) %>%summarise(cell_count =n(), .groups ="drop")table(x_fillers_count$filler)
0 1
80 80
## Check if all participants were measured at both areas of interest (emoji and profile picture)x_ia_count <- dfet %>% dplyr::select("id", "ia_label") %>%group_by(id, ia_label) %>%summarise(cell_count =n(), .groups ="drop") %>% dplyr::filter(ia_label =="aoi_photo"| ia_label =="aoi_emoji")table(x_ia_count$ia_label)
aoi_emoji aoi_photo
80 80
## Check if all participants saw all conditionsx_trial_count <- dfet %>% dplyr::filter(filler ==0) %>% dplyr::select("id", "condition") %>%group_by(id, condition) %>%summarise(cell_count =n(), .groups ="drop") %>%na.omit()table(x_trial_count$condition)
The responses in the columns racial_groups_5_TEXT, racial_groups_6_TEXT, white_group, white_group_5_TEXT, black_group, black_group_7_TEXT, asian_group, asian_group_10_TEXT, romani_group, and romani_group_3_TEXT have been removed from the raw data file for privacy reasons. These data are available upon request.
# Load datadfq <-read_survey("999_raw_qualtrics_main.csv")# Transform the dataframedfq <- dfq %>%## Reformat column names janitor::clean_names() %>%rename(id = participant_code,texting_usage = texting_usage_8) %>%## Convert text to lowercasemutate_if(is.character, tolower) %>%## Filter out unfinished trials and ## select rows where 'id' contains 's' and has 4 or fewer characters filter(!(finished ==FALSE), grepl("s", id) &nchar(id) <=4) %>%mutate(## Correct values from "s041" to "s044". ## The person who administered the task in the lab reported ## their mistake with the participant code.id =if_else(response_id =="r_1dxsfwtevfapfir", "s044", id),## Correct values for racialized group identification and cross-group friendship ## because the participant s061 mistakenly chose "other" and wrote "White" ## instead of selecting the "White" option.racial_groups =if_else(id =="s061", "branco", racial_groups),## Recode variablescross1_white_nr =case_when( cross1_white =="nenhum"~0, cross1_white =="um"~1, cross1_white =="entre dois a cinco"~2, cross1_white =="entre cinco a dez"~3, cross1_white =="mais de dez"~4,TRUE~NA_integer_ ),cross1_white =case_when( cross1_white =="nenhum"~"none", cross1_white =="um"~"one", cross1_white =="entre dois a cinco"~"two to five", cross1_white =="entre cinco a dez"~"five to ten", cross1_white =="mais de dez"~"more than ten",TRUE~NA_character_ ),cross2_white_nr =case_when( cross2_white =="nunca"~1, cross2_white =="ocasionalmente"~2, cross2_white =="às vezes"~3, cross2_white =="várias vezes"~4, cross2_white =="constantemente"~5,TRUE~0## For participants who responded with "none" to "cross1_white" ),cross2_white =case_when( cross2_white =="nunca"~"never", cross2_white =="ocasionalmente"~"occasionally", cross2_white =="às vezes"~"sometimes", cross2_white =="várias vezes"~"many times", cross2_white =="constantemente"~"all the time",TRUE~NA_character_ ),skin_tone_usage =case_when( skin_tone_usage =="não"~0, skin_tone_usage =="sim"~1,TRUE~NA_integer_ ),## Compute new variablesatt_mean = ( att_matrix_1 + att_matrix_2 + att_matrix_3 + att_matrix_4 + att_matrix_5 + att_matrix_6) /6) %>%## Relocaterelocate(att_mean, .after = att_matrix_6) %>%relocate(cross1_white_nr, .after = cross1_white) %>%relocate(cross2_white_nr, .after = cross2_white) %>%# Remove columns dplyr::select(-user_language) %>%# Add the suffix "_mainsurvey" to repeated columns with sociodemographic surveyrename_with(~paste0(., "_mainsurvey"), .cols =c("start_date", "end_date", "status", "progress","duration_in_seconds", "finished","recorded_date", "response_id", "distribution_channel" ))# Check participantslength(unique(dfq$id)) # 80 participants
[1] 80
# Check racialized identificationtable(dfq$racial_groups) # 76 white; 4 black participants
branco negro
76 4
ids_remove_participants <- dfq %>%filter(racial_groups =="negro") %>% dplyr::select(id) # 13, 14, 64, and 70# Check text messaging valuestable(dfq$texting_usage) # nobody reported not using text messaging chats
tibble [80 × 60] (S3: tbl_df/tbl/data.frame)
$ start_date_mainsurvey : POSIXct[1:80], format: "2022-03-09 09:06:50" "2022-03-09 10:26:11" "2022-03-09 11:37:18" "2022-03-09 12:49:54" ...
$ end_date_mainsurvey : POSIXct[1:80], format: "2022-03-09 10:11:56" "2022-03-09 11:24:42" "2022-03-09 12:40:04" "2022-03-09 14:29:54" ...
$ status_mainsurvey : chr [1:80] "ip address" "ip address" "ip address" "ip address" ...
..- attr(*, "label")= Named chr "Response Type"
.. ..- attr(*, "names")= chr "Status"
$ progress_mainsurvey : num [1:80] 100 100 100 100 100 100 100 100 100 100 ...
..- attr(*, "label")= Named chr "Progress"
.. ..- attr(*, "names")= chr "Progress"
$ duration_in_seconds_mainsurvey : num [1:80] 3905 3511 3765 5999 3655 ...
..- attr(*, "label")= Named chr "Duration (in seconds)"
.. ..- attr(*, "names")= chr "Duration (in seconds)"
$ finished_mainsurvey : logi [1:80] TRUE TRUE TRUE TRUE TRUE TRUE ...
..- attr(*, "label")= Named chr "Finished"
.. ..- attr(*, "names")= chr "Finished"
$ recorded_date_mainsurvey : POSIXct[1:80], format: "2022-03-09 10:11:57" "2022-03-09 11:24:43" "2022-03-09 12:40:04" "2022-03-09 14:29:54" ...
$ response_id_mainsurvey : chr [1:80] "r_3oyzcrk1uvw7y06" "r_xguhkqyjq1ilfup" "r_btxq9mifzv3shuz" "r_sb5mov1ubd8dtq5" ...
..- attr(*, "label")= Named chr "Response ID"
.. ..- attr(*, "names")= chr "ResponseId"
$ distribution_channel_mainsurvey: chr [1:80] "anonymous" "anonymous" "anonymous" "anonymous" ...
..- attr(*, "label")= Named chr "Distribution Channel"
.. ..- attr(*, "names")= chr "DistributionChannel"
$ id : chr [1:80] "s001" "s002" "s003" "s004" ...
$ texting_usage : num [1:80] 100 100 73 90 71 95 100 63 13 73 ...
..- attr(*, "label")= Named chr "Com que frequência usa, num dia típico, serviços de mensagens de texto? (por exemplo, Whatsapp, Messenger, Sign"| __truncated__
.. ..- attr(*, "names")= chr "texting_usage_8"
$ emoji_usage1 : num [1:80] 6 6 6 5 6 6 5 6 4 4 ...
..- attr(*, "label")= Named chr "Nas suas comunicações escritas, com que frequência envia emojis?"
.. ..- attr(*, "names")= chr "emoji_usage1"
$ emoji_usage2 : num [1:80] 6 6 6 5 6 6 6 6 5 5 ...
..- attr(*, "label")= Named chr "Nas suas comunicações escritas, com que frequência recebe emojis?"
.. ..- attr(*, "names")= chr "emoji_usage2"
$ skin_color_id : num [1:80] 1 2 2 1 2 1 2 1 2 2 ...
..- attr(*, "label")= Named chr "No geral, o meu tom de pele é mais semelhante com..."
.. ..- attr(*, "names")= chr "skin_color_id"
$ racial_groups : chr [1:80] "branco" "branco" "branco" "branco" ...
$ racial_groups_5_text : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Qual das seguintes opções considera que melhor descreve a sua pertença e/ou origem?\n\n(Escolha apenas um) - Ou"| __truncated__
.. ..- attr(*, "names")= chr "racial_groups_5_TEXT"
$ racial_groups_6_text : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Qual das seguintes opções considera que melhor descreve a sua pertença e/ou origem?\n\n(Escolha apenas um) - Or"| __truncated__
.. ..- attr(*, "names")= chr "racial_groups_6_TEXT"
$ white_group : chr [1:80] "available upon request" "available upon request" "available upon request" "available upon request" ...
..- attr(*, "label")= Named chr "Branco / Português branco / De origem europeia - Selected Choice"
.. ..- attr(*, "names")= chr "white_group"
$ white_group_5_text : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Branco / Português branco / De origem europeia - outra origem. Qual? - Texto"
.. ..- attr(*, "names")= chr "white_group_5_TEXT"
$ black_group : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Negro / Português Negro / Afrodescendente / De origem africana - Selected Choice"
.. ..- attr(*, "names")= chr "black_group"
$ black_group_7_text : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Negro / Português Negro / Afrodescendente / De origem africana - outra origem. Qual? - Texto"
.. ..- attr(*, "names")= chr "black_group_7_TEXT"
$ asian_group : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Asiático / Português de origem asiática / De origem asiática - Selected Choice"
.. ..- attr(*, "names")= chr "asian_group"
$ asian_group_10_text : logi [1:80] NA NA NA NA NA NA ...
..- attr(*, "label")= Named chr "Asiático / Português de origem asiática / De origem asiática - outra origem. Qual? - Texto"
.. ..- attr(*, "names")= chr "asian_group_10_TEXT"
$ romani_group : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Cigano / Português cigano / Roma / De origem cigana - Selected Choice"
.. ..- attr(*, "names")= chr "romani_group"
$ romani_group_3_text : logi [1:80] NA NA NA NA NA NA ...
..- attr(*, "label")= Named chr "Cigano / Português cigano / Roma / De origem cigana - outra origem. Qual? - Texto"
.. ..- attr(*, "names")= chr "romani_group_3_TEXT"
$ identification_level : num [1:80] 6 6 5 7 5 7 7 7 6 6 ...
..- attr(*, "label")= Named chr "Eu identifico-me com [QID5-ChoiceTextEntryValue-5][QID5-ChoiceTextEntryValue-6][QID6-ChoiceGroup-SelectedChoice"| __truncated__
.. ..- attr(*, "names")= chr "identification_level"
$ cross1_white : chr [1:80] "more than ten" "none" "two to five" "one" ...
$ cross1_white_nr : num [1:80] 4 0 2 1 2 2 3 2 3 2 ...
$ cross1_black : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Quantos amigos seus são Brancos, Asiáticos, Ciganos ou Bi-raciais?"
.. ..- attr(*, "names")= chr "cross1_black"
$ cross1_asian : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Quantos amigos seus são Brancos, Negros, Ciganos ou Bi-raciais?"
.. ..- attr(*, "names")= chr "cross1_asian"
$ cross1_romani : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Quantos amigos seus são Brancos, Negros, Asiáticos ou Bi-raciais?"
.. ..- attr(*, "names")= chr "cross1_romani"
$ cross1_mixed : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Quantos amigos seus são Brancos, Negros, Asiáticos, Ciganos, ou Bi-raciais de diferentes origens?"
.. ..- attr(*, "names")= chr "cross1_mixed"
$ cross1_other : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Quantos amigos seus são Brancos, Negros, Asiáticos, Ciganos ou Bi-raciais?"
.. ..- attr(*, "names")= chr "cross1_other"
$ cross2_white : chr [1:80] "all the time" NA "occasionally" "occasionally" ...
$ cross2_white_nr : num [1:80] 5 0 2 2 3 5 5 3 2 3 ...
$ cross2_other : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Com que frequência passa tempo com amigos que são Brancos, Negros, Asiáticos, Ciganos ou Bi-raciais?"
.. ..- attr(*, "names")= chr "cross2_other"
$ cross2_black : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Com que frequência passa tempo com amigos que são Brancos, Asiáticos, Ciganos ou Bi-raciais?"
.. ..- attr(*, "names")= chr "cross2_black"
$ cross2_asian : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Com que frequência passa tempo com amigos que são Brancos, Negros, Ciganos ou Bi-raciais?"
.. ..- attr(*, "names")= chr "cross2_asian"
$ cross2_romani : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Com que frequência passa tempo com amigos que são Brancos, Negros, Asiáticos ou Bi-raciais?"
.. ..- attr(*, "names")= chr "cross2_romani"
$ cross2_mixed : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Com que frequência passa tempo com amigos que são Brancos, Negros, Asiáticos, Ciganos, ou Bi-raciais de diferentes origens?"
.. ..- attr(*, "names")= chr "cross2_mixed"
$ att_matrix_1 : num [1:80] 6 3 4 4 4 4 4 5 4 4 ...
..- attr(*, "label")= Named chr "Para mim, usar emojis com tons de pele nas mensagens seria... - muito mau:muito bom"
.. ..- attr(*, "names")= chr "att_matrix_1"
$ att_matrix_2 : num [1:80] 4 3 4 4 4 4 4 4 4 3 ...
..- attr(*, "label")= Named chr "Para mim, usar emojis com tons de pele nas mensagens seria... - muito prejudicial:muito benéfico"
.. ..- attr(*, "names")= chr "att_matrix_2"
$ att_matrix_3 : num [1:80] 5 3 4 4 4 4 4 5 4 3 ...
..- attr(*, "label")= Named chr "Para mim, usar emojis com tons de pele nas mensagens seria... - muito insensato:muito sensato"
.. ..- attr(*, "names")= chr "att_matrix_3"
$ att_matrix_4 : num [1:80] 5 3 4 4 1 4 4 5 4 4 ...
..- attr(*, "label")= Named chr "Para mim, usar emojis com tons de pele nas mensagens seria... - muito desagradável:muito agradável"
.. ..- attr(*, "names")= chr "att_matrix_4"
$ att_matrix_5 : num [1:80] 4 3 4 4 1 4 4 5 4 4 ...
..- attr(*, "label")= Named chr "Para mim, usar emojis com tons de pele nas mensagens seria... - muito desconfortável:muito confortável"
.. ..- attr(*, "names")= chr "att_matrix_5"
$ att_matrix_6 : num [1:80] 5 3 4 4 4 5 4 5 4 4 ...
..- attr(*, "label")= Named chr "Para mim, usar emojis com tons de pele nas mensagens seria... - muito aborrecido:muito divertido"
.. ..- attr(*, "names")= chr "att_matrix_6"
$ att_mean : num [1:80] 4.83 3 4 4 3 ...
..- attr(*, "label")= Named chr "Para mim, usar emojis com tons de pele nas mensagens seria... - muito mau:muito bom"
.. ..- attr(*, "names")= chr "att_matrix_1"
$ inj_white : num [1:80] 6 6 7 7 4 5 4 6 7 7 ...
..- attr(*, "label")= Named chr "Se eu usasse emojis com tom de pele claro, a maioria das pessoas que eu conheço iria..."
.. ..- attr(*, "names")= chr "inj_white"
$ inj_black : num [1:80] 2 4 7 4 7 3 4 3 7 4 ...
..- attr(*, "label")= Named chr "Se eu usasse emojis com tom de pele escuro, a maioria das pessoas que eu conheço iria..."
.. ..- attr(*, "names")= chr "inj_black"
$ inj_yellow : num [1:80] 7 7 7 7 7 4 4 6 7 7 ...
..- attr(*, "label")= Named chr "Se eu usasse emojis com tom de pele amarelo, a maioria das pessoas que eu conheço iria..."
.. ..- attr(*, "names")= chr "inj_yellow"
$ inj_should_1 : num [1:80] 6 4 4 4 4 4 4 4 4 4 ...
..- attr(*, "label")= Named chr "A maioria das pessoas que eu conheço pensa que eu... - Não devo usaremojis com tons de pele:Devo usaremojis com tons de pele"
.. ..- attr(*, "names")= chr "inj_should_1"
$ inj_importance : num [1:80] 4 1 4 1 2 4 4 3 2 1 ...
..- attr(*, "label")= Named chr "Na sua estimativa, quão importante é usar emoji com tons de pele para um típico jovem?"
.. ..- attr(*, "names")= chr "inj_importance"
$ descriptive_norm : num [1:80] 6 2 4 6 2 6 4 5 4 5 ...
..- attr(*, "label")= Named chr "Na sua estimativa, com que frequência um jovem típico usa emoji com tons de pele?"
.. ..- attr(*, "names")= chr "descriptive_norm"
$ skin_tone_usage : num [1:80] 1 1 1 0 1 1 0 1 0 1 ...
$ skin_tone_emoji_id : num [1:80] 2 3 2 NA 2 2 NA 1 NA 2 ...
..- attr(*, "label")= Named chr "Entre estes tons de pele, qual é que mais utilizou nos emojis?"
.. ..- attr(*, "names")= chr "skin_tone_emoji_ID"
$ usage_skintone1 : num [1:80] 3 1 5 NA 2 5 NA 4 NA 2 ...
..- attr(*, "label")= Named chr "Nas suas comunicações escritas, com que frequência envia emojis tons de pele?"
.. ..- attr(*, "names")= chr "usage_skintone1"
$ usage_skintone2 : num [1:80] 3 2 5 5 2 5 4 4 5 2 ...
..- attr(*, "label")= Named chr "Nas suas comunicações escritas, com que frequência recebe emojis tons de pele?"
.. ..- attr(*, "names")= chr "usage_skintone2"
$ politic_left_right : num [1:80] 3 6 5 4 6 5 1 5 1 6 ...
..- attr(*, "label")= Named chr "Em termos políticos, as pessoas falam de \"a esquerda\" e \"a direita\".\nComo colocaria a sua opinião nesta es"| __truncated__
.. ..- attr(*, "names")= chr "politic_left_right"
$ goal_suspected : chr [1:80] "perceber de que maneira o uso de emojis com tom de pele pode alterar a perceção do recetor." "perceber a influência da utilização de emojis com cor de pele, se conta mais a fotografia da pessoa no whatsapp"| __truncated__ "ver se prestamos atenção aos tons de pele utilizados nos emojis e se os associamos às pessoas" "na minha opinião o objetivo era ver se existe alguma relação entre a utilização de emojis com tons de pele e a "| __truncated__ ...
..- attr(*, "label")= Named chr "Na sua opinião, qual foi o objetivo deste estudo?"
.. ..- attr(*, "names")= chr "goal_suspected"
$ emoji_influence : num [1:80] 4 5 5 5 5 6 5 3 2 6 ...
..- attr(*, "label")= Named chr "Nesta tarefa estamos interessados em compreender como as pessoas interpretam diferentes tipos de emojis.\n\nNa "| __truncated__
.. ..- attr(*, "names")= chr "emoji_influence"
- attr(*, "column_map")= tibble [58 × 7] (S3: tbl_df/tbl/data.frame)
..$ qname : chr [1:58] "StartDate" "EndDate" "Status" "Progress" ...
..$ description: chr [1:58] "Start Date" "End Date" "Response Type" "Progress" ...
..$ main : chr [1:58] "Start Date" "End Date" "Response Type" "Progress" ...
..$ sub : chr [1:58] "" "" "" "" ...
..$ ImportId : chr [1:58] "startDate" "endDate" "status" "progress" ...
..$ timeZone : chr [1:58] "Europe/London" "Europe/London" NA NA ...
..$ choiceId : logi [1:58] NA NA NA NA NA NA ...
rm(ids_remove_participants)
Sociodemographic Survey Data
# Load datadfs <-read_survey("999_raw_qualtrics_sociodemographic.csv")# Transform the dataframedfs <- dfs %>%# Reformat column names janitor::clean_names() %>%rename(id = codigo_id) %>%# Convert text to lowercasemutate_if(is.character, tolower) %>%# Keep the rows where participants have finished the survey and have a correct IDfilter(!(finished ==0), grepl("s", id)) %>%# Correct values from "s00399" to "s003"mutate(id =if_else(response_id =="r_2cnoxenj00osqy4", "s003", id)) %>%# Remove columns dplyr::select(-user_language) %>%# Add the suffix "_sociosurvey" to repeated columns with main surveyrename_with(~paste0(., "_sociosurvey"), .cols =c("start_date", "end_date", "status", "progress","duration_in_seconds", "finished","recorded_date", "response_id", "distribution_channel" ))# Check if participants mistakenly wrote their gender instead of selecting the optionsunique(dfs$gender_9_text)
tibble [80 × 25] (S3: tbl_df/tbl/data.frame)
$ start_date_sociosurvey : POSIXct[1:80], format: "2022-03-09 10:19:43" "2022-03-09 11:30:52" "2022-03-09 12:45:49" "2022-03-09 14:40:02" ...
$ end_date_sociosurvey : POSIXct[1:80], format: "2022-03-09 10:20:03" "2022-03-09 11:31:09" "2022-03-09 12:46:14" "2022-03-09 14:40:43" ...
$ status_sociosurvey : num [1:80] 0 0 0 0 0 0 0 0 0 0 ...
..- attr(*, "label")= Named chr "Response Type"
.. ..- attr(*, "names")= chr "Status"
$ progress_sociosurvey : num [1:80] 100 100 100 100 100 100 100 100 100 100 ...
..- attr(*, "label")= Named chr "Progress"
.. ..- attr(*, "names")= chr "Progress"
$ duration_in_seconds_sociosurvey : num [1:80] 20 16 25 41 34 19 29 18 20 24 ...
..- attr(*, "label")= Named chr "Duration (in seconds)"
.. ..- attr(*, "names")= chr "Duration..in.seconds."
$ finished_sociosurvey : num [1:80] 1 1 1 1 1 1 1 1 1 1 ...
..- attr(*, "label")= Named chr "Finished"
.. ..- attr(*, "names")= chr "Finished"
$ recorded_date_sociosurvey : POSIXct[1:80], format: "2022-03-09 10:20:04" "2022-03-09 11:31:10" "2022-03-09 12:46:15" "2022-03-09 14:40:44" ...
$ response_id_sociosurvey : chr [1:80] "r_1cciz2fmjnowlvz" "r_3oxw57rpevhbmih" "r_2cnoxenj00osqy4" "r_2cixihtfqwnnts8" ...
..- attr(*, "label")= Named chr "Response ID"
.. ..- attr(*, "names")= chr "ResponseId"
$ recipient_last_name : logi [1:80] NA NA NA NA NA NA ...
..- attr(*, "label")= Named chr "Recipient Last Name"
.. ..- attr(*, "names")= chr "RecipientLastName"
$ recipient_first_name : logi [1:80] NA NA NA NA NA NA ...
..- attr(*, "label")= Named chr "Recipient First Name"
.. ..- attr(*, "names")= chr "RecipientFirstName"
$ recipient_email : logi [1:80] NA NA NA NA NA NA ...
..- attr(*, "label")= Named chr "Recipient Email"
.. ..- attr(*, "names")= chr "RecipientEmail"
$ external_reference : logi [1:80] NA NA NA NA NA NA ...
..- attr(*, "label")= Named chr "External Data Reference"
.. ..- attr(*, "names")= chr "ExternalReference"
$ distribution_channel_sociosurvey: chr [1:80] "anonymous" "anonymous" "anonymous" "anonymous" ...
..- attr(*, "label")= Named chr "Distribution Channel"
.. ..- attr(*, "names")= chr "DistributionChannel"
$ age : num [1:80] 19 22 21 21 49 19 48 20 50 18 ...
..- attr(*, "label")= Named chr "Pode escrever a sua idade (em números), por favor?"
.. ..- attr(*, "names")= chr "age"
$ gender : num [1:80] 1 1 1 1 1 1 1 1 1 1 ...
..- attr(*, "label")= Named chr "Qual é o seu sexo? - Selected Choice"
.. ..- attr(*, "names")= chr "gender"
$ gender_9_text : logi [1:80] NA NA NA NA NA NA ...
..- attr(*, "label")= Named chr "Qual é o seu sexo? - Outro. Identifico o meu sexo como: - Texto"
.. ..- attr(*, "names")= chr "gender_9_TEXT"
$ nationality : num [1:80] 1 1 1 1 1 1 1 1 1 1 ...
..- attr(*, "label")= Named chr "Qual é a sua nacionalidade? - Selected Choice"
.. ..- attr(*, "names")= chr "nationality"
$ nationality_2_text : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Qual é a sua nacionalidade? - Outra - Texto"
.. ..- attr(*, "names")= chr "nationality_2_TEXT"
$ language : num [1:80] 1 1 1 1 1 1 1 1 1 1 ...
..- attr(*, "label")= Named chr "Português europeu é a sua língua nativa?"
.. ..- attr(*, "names")= chr "language"
$ residence_pt : chr [1:80] NA NA NA NA ...
..- attr(*, "label")= Named chr "Há quantos anos reside em Portugal?"
.. ..- attr(*, "names")= chr "residence_pt"
$ fluency_pt : num [1:80] NA NA NA NA NA NA NA NA NA NA ...
..- attr(*, "label")= Named chr "Como avalia a sua fluência em Português (Europeu)?"
.. ..- attr(*, "names")= chr "fluency_pt"
$ education : num [1:80] 2 4 2 2 4 2 3 2 5 2 ...
..- attr(*, "label")= Named chr "Qual é o nível de educação mais elevado que já concluiu? - Selected Choice"
.. ..- attr(*, "names")= chr "education"
$ education_7_text : logi [1:80] NA NA NA NA NA NA ...
..- attr(*, "label")= Named chr "Qual é o nível de educação mais elevado que já concluiu? - Outro - Texto"
.. ..- attr(*, "names")= chr "education_7_TEXT"
$ occupation : num [1:80] 1 1 2 1 2 1 2 1 2 1 ...
..- attr(*, "label")= Named chr "Qual é a sua situação laboral?"
.. ..- attr(*, "names")= chr "occupation"
$ id : chr [1:80] "s001" "s002" "s003" "s004" ...
- attr(*, "column_map")= tibble [26 × 7] (S3: tbl_df/tbl/data.frame)
..$ qname : chr [1:26] "StartDate" "EndDate" "Status" "Progress" ...
..$ description: chr [1:26] "Start Date" "End Date" "Response Type" "Progress" ...
..$ main : chr [1:26] "Start Date" "End Date" "Response Type" "Progress" ...
..$ sub : chr [1:26] "" "" "" "" ...
..$ ImportId : chr [1:26] "startDate" "endDate" "status" "progress" ...
..$ timeZone : chr [1:26] "Europe/London" "Europe/London" NA NA ...
..$ choiceId : logi [1:26] NA NA NA NA NA NA ...
rm(ids_lowfluency_participants)
Data Wrangling
# Sanity Check## Check which columns are repeated across dataframesdplyr::intersect(names(dfq), names(dfs)) # only id
[1] "id"
dplyr::intersect(names(dfq), names(dfet)) # only id
[1] "id"
dplyr::intersect(names(dfs), names(dfet)) # only id
[1] "id"
# Merge dataframesdf <-merge(merge(dfet, dfq, by ="id", all =TRUE), dfs, by ="id", all =TRUE)# Add information about who volunteered and who received partial credit# This was not directly recorded in the data to comply with privacy regulations.credit_ids <-tolower(c("S001","S002","S003","S004","S005","S006","S007","S008","S009","S010","S011","S012","S013","S014","S015","S016","S017","S018","S019","S020","S021","S022","S023","S024","S025","S026","S027","S028","S029","S030","S078","S079","S080" ) )df <- df %>%mutate(volunteer =ifelse(id %in% credit_ids, "credit", "volunteer"))# Transform certain variables into ordered factorsdf <- df %>%mutate(sender_competence_f =as.ordered(sender_competence),sender_warmth_f =as.ordered(sender_warmth),quality_relationship_f =as.ordered(quality_relationship))# Relocate columnsdf <- df %>%relocate(congruency, .after = eye_used) %>%relocate(emoji_color, .after = congruency) %>%relocate(profile_pic, .after = emoji_color) %>%relocate(condition, .after = id) %>%relocate(filler, .after = condition) %>%relocate(age, .after = id) %>%relocate(gender, .after = id) %>%relocate(sender_competence_f, .after = sender_competence) %>%relocate(sender_warmth_f, .after = sender_warmth) %>%relocate(quality_relationship_f, .after = quality_relationship)# Remove fillers and rows related to non-aoidf <- df %>% dplyr::filter(filler ==0, !is.na(congruency))# Remove participantsto_exclude <- df %>%filter(## To be eligible for this study, participants must be fluent European Portuguese speakers fluency_pt >5& nationality ==2## Given that the majority of the sample self-identified as White, ## we restricted our analysis to this demographic| racial_groups =="negro") %>% dplyr::select(id) %>%distinct() %>%pull()print(to_exclude)
# Prepare data so there is one row per participantx_socio <- df[!duplicated(df$id), ]# View racialized identity descriptives; White = brancotable(x_socio$racial_groups)
# Compare model with and without interaction## Model without interactionsender_warmth_base <-clmm( sender_warmth_f ~1+ emoji_color + profile_pic + emoji_hand_type + texting_usage_s + (1| id),data = dfp,Hess =TRUE,nAGQ =10,link ="logit",threshold ="flexible" )## Check effectsRVAideMemoire::Anova.clmm(sender_warmth_base, type ="2")
# Multicollinearity for categorical predictors with an interactionsw_multi <-lm(sender_warmth ~ emoji_color * profile_pic + emoji_hand_type + texting_usage_s, data = dfp)car::vif(sw_multi, type ="predictor")
## Emmeans explains the interaction contrasts process as follow: "Contrasts are## generated for each factor separately, one at a time; and these contrasts## are applied to the object (the first time around) or to the previous## result (subsequently). The final result comprises contrasts of contrasts,## or, equivalently, products of contrasts for the factors involved".model_parameters( emmeans::contrast(sw_emm, interaction =TRUE),ci =0.95,bootstrap =TRUE,iterations =10000,p_adjust ="fdr") %>%kbl(table.attr ='data-quarto-disable-processing="true"') %>%kable_styling(full_width = T, c("striped", "hover"))
emoji_color_eff
profile_pic_eff
Coefficient
SE
CI
CI_low
CI_high
z
df_error
p
yellow effect
neutral effect
-0.2748596
0.1472638
0.95
-0.5634913
0.0137721
-1.8664443
Inf
0.0929688
dark effect
neutral effect
-0.2115933
0.1488406
0.95
-0.5033155
0.0801290
-1.4216096
Inf
0.1994652
light effect
neutral effect
0.4864529
0.1474258
0.95
0.1975035
0.7754022
3.2996446
Inf
0.0029042
yellow effect
black effect
-0.0052873
0.1485241
0.95
-0.2963893
0.2858146
-0.0355991
Inf
0.9932426
dark effect
black effect
0.4929711
0.1448978
0.95
0.2089766
0.7769657
3.4021981
Inf
0.0029042
light effect
black effect
-0.4876838
0.1473929
0.95
-0.7765686
-0.1987990
-3.3087328
Inf
0.0029042
yellow effect
white effect
0.2801469
0.1456281
0.95
-0.0052789
0.5655728
1.9237149
Inf
0.0929688
dark effect
white effect
-0.2813779
0.1427028
0.95
-0.5610702
-0.0016856
-1.9717760
Inf
0.0929688
light effect
white effect
0.0012309
0.1453437
0.95
-0.2836374
0.2860993
0.0084692
Inf
0.9932426
# View how interaction contrasts were calculated# the columns should be read verticallycoef(emmeans::contrast(sw_emm, interaction =TRUE))
# Compare model with and without interaction## Model without interactionsender_competence_base <-clmm( sender_competence_f ~1+ emoji_color + profile_pic + emoji_hand_type + texting_usage_s + (1| id),data = dfp,Hess =TRUE,nAGQ =10,link ="logit",threshold ="flexible" )## Check effectsRVAideMemoire::Anova.clmm(sender_competence_base, type ="2")
# Multicollinearity for categorical predictors with an interactionsc_multi <-lm(sender_competence ~ emoji_color * profile_pic + emoji_hand_type + texting_usage_s, data = dfp)car::vif(sc_multi, type ="predictor") # no issues
performance_aic(qr_logit) # qr_logit had higher performance
[1] 1979.794
# Compare model with and without interaction## Model without interactionquality_base <-clmm( quality_relationship_f ~1+ emoji_color + profile_pic + emoji_hand_type + texting_usage_s + (1| id),data = dfp,Hess =TRUE,nAGQ =10,link ="logit",threshold ="flexible" )## Check effectsRVAideMemoire::Anova.clmm(quality_base, type ="2")
# Multicollinearity for categorical predictors with an interactionqr_multi <-lm(quality_relationship ~ emoji_color * profile_pic + emoji_hand_type + texting_usage_s, data = dfp)car::vif(qr_multi, type ="predictor") # no issues
Senders Racialized Identity in the Neutral Condition
# Prepare dataframe to only include neutral profilesdatra <- dfp %>% dplyr::filter(profile_pic =="neutral")# Compute index of participant's confident level about sender's racialized profiledatra$confident_level <- datra$sender_black - datra$sender_white
# General distributionhist_boxplot(datra$confident_level, col ="lightblue", freq = T, density = F)
# Distribution by conditionggplot(datra, aes(x = confident_level)) +geom_histogram(aes(y =after_stat(density)), position ="identity", bins =20, fill ="lightblue") +geom_boxplot(aes(y =0), width =0.1) +facet_wrap(~ emoji_color + profile_pic, scales ="free_y") +theme_minimal()
# ANOVA model fails the assumption of normally distributed residualsanova_model <-aov(confident_level ~ emoji_color + emoji_hand_type + texting_usage_s +Error(id), data = datra)residuals_anova <- anova_model$Within$residualsqqPlot(residuals_anova)
107 139
105 137
Model
# Linear Mixed-Effects Model using Gaussian link results in singular modelsr_lmer <-lmer(confident_level ~ emoji_color + emoji_hand_type + texting_usage_s + (1|id), data = datra)
Subtracting the responses from the questions ‘How certain are you that the sender is Black?’ and ‘How certain are you that the sender is White?’ resulted in a large number of zeros, indicating that many participants responded with the same value for both questions.
However, this results in a challenge for data analysis due to the extreme unbalanced distribution. To address this, one possible strategy involves initially comparing zero and non-zero responses to identify any biased patterns that might justify participants’ decisions to provide zero as an answer. Subsequently, if any issues arise, we can exclude all the zero responses and focus solely on analyzing the non-zero responses.
PART I: Examine the zero responses
## Check zero inflationdatra$confident_level_test <-abs(datra$confident_level)table(datra$confident_level_test)
## Transform data so zero, which is the focus, is 1, and non-zero is 0.datra$confident_level_zero <-ifelse(datra$confident_level ==0, 1, 0)table(datra$confident_level_zero)
The confident_level was calculated as datra$sender_black - datra$sender_white, which means that negative values indicate a higher confidence that the sender is White; and positive values indicate a higher confidence that the sender is Black.
# Transform data so only non-zero are includeddatra$confident_level_nonzero <-ifelse(datra$confident_level ==0, NA, datra$confident_level)table(datra$confident_level_nonzero)
# Check if all levels of emoji colors are different from 0# Subset the data for each level of emoji_colordata_dark <- datra$confident_level_nonzero[datra$emoji_color =="dark"]data_light <- datra$confident_level_nonzero[datra$emoji_color =="light"]data_yellow <- datra$confident_level_nonzero[datra$emoji_color =="yellow"]# Run the Anderson-Darling test for normalityad.test(data_dark)
Anderson-Darling normality test
data: data_dark
A = 1.2154, p-value = 0.003137
ad.test(data_light)
Anderson-Darling normality test
data: data_light
A = 0.83676, p-value = 0.0273
ad.test(data_yellow)
Anderson-Darling normality test
data: data_yellow
A = 0.66774, p-value = 0.0696
# Perform Wilcoxon signed-rank test for each subset against 0# Note: Using paired = FALSE for one-sample scenariotest_dark <-wilcox.test(data_dark, mu =0, paired =FALSE, exact =FALSE); test_dark
Wilcoxon signed rank test with continuity correction
data: data_dark
V = 651, p-value = 0.00004396
alternative hypothesis: true location is not equal to 0
test_light <-wilcox.test(data_light, mu =0, paired =FALSE, exact =FALSE); test_light
Wilcoxon signed rank test with continuity correction
data: data_light
V = 19.5, p-value = 0.00001122
alternative hypothesis: true location is not equal to 0
test_yellow <-wilcox.test(data_yellow, mu =0, paired =FALSE, exact =FALSE); test_yellow
Wilcoxon signed rank test with continuity correction
data: data_yellow
V = 30, p-value = 0.002844
alternative hypothesis: true location is not equal to 0
de <-c(test_dark$p.value, test_light$p.value, test_yellow$p.value)fdrs <-p.adjust(de, method ="BH")fdrs
Zero duration dwell times will be removed to ensure dwell time analysis is not contaminated by skippings (Horstmann et al., 2016). As per pre-registration, unreasonable gazes (±2 standard deviations) will be removed.
Emojis’ AOI
# General distributionhist_boxplot(dfe$ia_dwell_time, col ="lightblue", freq = T, density = F)
# Distribution by conditionggplot(dfe, aes(x = ia_dwell_time)) +geom_histogram(aes(y =after_stat(density)), position ="identity", bins =20, fill ="lightblue") +geom_boxplot(aes(y =0), width =0.1) +facet_wrap(~ emoji_color + profile_pic, scales ="free_y") +theme_minimal()
# Remove zero valuessum(!is.na(dfe$ia_dwell_time)) # total of data points
[1] 684
sum(dfe$ia_dwell_time ==0) # total of data points with zero
[1] 77
dfe$ia_dwell_time[dfe$ia_dwell_time ==0] <-NAsum(!is.na(dfe$ia_dwell_time)) # remaining data points
[1] 607
# Remove outliers## Identify values less than mean - 2*SD or greater than mean + 2*SDdw_mean_val <-mean(dfe$ia_dwell_time, na.rm =TRUE)dw_std_dev <-sd(dfe$ia_dwell_time, na.rm =TRUE)dw_outliers <-which(dfe$ia_dwell_time < (dw_mean_val -2* dw_std_dev) | dfe$ia_dwell_time > (dw_mean_val +2* dw_std_dev))length(dw_outliers)
[1] 17
dfe$ia_dwell_time[dw_outliers] # values in milliseconds
## Recode outliers as NAsum(!is.na(dfe$ia_dwell_time)) # total of data points
[1] 607
dfe$ia_dwell_time[dw_outliers] <-NAsum(!is.na(dfe$ia_dwell_time)) # remaining data points
[1] 590
# ANOVA model fails the assumption of normally distributed residualsanova_model <-aov(ia_dwell_time ~ profile_pic * emoji_color + emoji_hand_type + texting_usage_s +Error(id),data = dfe)residuals_anova <- anova_model$Within$residualsqqPlot(residuals_anova)
145 494
143 492
Model
# Linear Mixed-Effects Model is not a good fitdw_lmer <-lmer(ia_dwell_time ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1| id),data = dfe)check_predictions(dw_lmer)
# Generalized Linear Mixed-Effects Model## Base model without interactiondwell_emoji_base <-glmmTMB(ia_dwell_time ~1+ emoji_color + profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =Gamma(link ="log"), data = dfe)## Check effectsAnova(dwell_emoji_base, type ="2")
DHARMa nonparametric dispersion test via sd of residuals fitted vs. simulated
data: simulationOutput
dispersion = 0.97004, p-value = 0.848
alternative hypothesis: two.sided
testOutliers(dw_check)
DHARMa outlier test based on exact binomial test with approximate expectations
data: dw_check
outliers at both margin(s) = 2, observations = 590, p-value = 0.3459
alternative hypothesis: true probability of success is not equal to 0.007968127
95 percent confidence interval:
0.0004107882 0.0121911349
sample estimates:
frequency of outliers (expected: 0.00796812749003984 )
0.003389831
## Recode outliers as NAsum(!is.na(dfp$ia_dwell_time)) # total of data points
[1] 529
dfp$ia_dwell_time[dw_outliers] <-NAsum(!is.na(dfp$ia_dwell_time)) # total of data points
[1] 510
# ANOVA model fails the assumption of normally distributed residualsanova_model <-aov(ia_dwell_time ~ profile_pic * emoji_color + emoji_hand_type + texting_usage_s +Error(id),data = dfp)residuals_anova <- anova_model$Within$residualsqqPlot(residuals_anova)
496 205
494 203
Model
# Linear Mixed-Effects Model is not a good fitdw_lmer <-lmer(ia_dwell_time ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1| id),data = dfp)check_predictions(dw_lmer)
# Generalized Linear Mixed-Effects Model## Base model without interactiondwell_profile_base <-glmmTMB(ia_dwell_time ~1+ emoji_color + profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =Gamma(link ="log"), data = dfp)## Check effectsAnova(dwell_profile_base, type ="2")
DHARMa nonparametric dispersion test via sd of residuals fitted vs. simulated
data: simulationOutput
dispersion = 0.91084, p-value = 0.552
alternative hypothesis: two.sided
testOutliers(dw_check)
DHARMa outlier test based on exact binomial test with approximate expectations
data: dw_check
outliers at both margin(s) = 1, observations = 510, p-value = 0.2028
alternative hypothesis: true probability of success is not equal to 0.007968127
95 percent confidence interval:
0.00004964153 0.01087595158
sample estimates:
frequency of outliers (expected: 0.00796812749003984 )
0.001960784
Post-hoc comparisons
# Base model# Calculate the predicted valuesdw_emm_bp <-emmeans(dwell_profile_base, ~ emoji_color)# Calculate the comparisonsmodel_parameters( emmeans::contrast(dw_emm_bp),ci =0.95,bootstrap =TRUE,iterations =10000,p_adjust ="fdr") %>%kbl(table.attr ='data-quarto-disable-processing="true"') %>%kable_styling(full_width = T, c("striped", "hover"))
# Distribution by conditionggplot(dfe, aes(x = ia_run_count)) +geom_histogram(aes(y =after_stat(density)), position ="identity", bins =20, fill ="lightblue") +geom_boxplot(aes(y =0), width =0.1) +facet_wrap(~ emoji_color + profile_pic, scales ="free_y") +theme_minimal()
# Remove outliers## Identify values less than mean - 2*SD or greater than mean + 2*SDre_mean_val <-mean(dfe$ia_run_count, na.rm =TRUE)re_std_dev <-sd(dfe$ia_run_count, na.rm =TRUE)re_outliers <-which(dfe$ia_run_count < (re_mean_val -2* re_std_dev) | dfe$ia_run_count > (re_mean_val +2* re_std_dev))length(re_outliers)
[1] 20
dfe$ia_run_count[re_outliers]
[1] 7 6 14 6 6 6 6 9 6 6 8 6 6 6 7 6 10 32 11 7
## Recode outliers as NAsum(!is.na(dfe$ia_run_count)) # total of data points
[1] 684
dfe$ia_run_count[re_outliers] <-NAsum(!is.na(dfe$ia_run_count)) # total of data points
[1] 664
# ANOVA model fails the assumption of normally distributed residualsanova_model <-aov(ia_run_count ~ profile_pic * emoji_color + emoji_hand_type + texting_usage_s +Error(id),data = dfe)residuals_anova <- anova_model$Within$residualsqqPlot(residuals_anova)
123 98
121 96
Model
# Linear Mixed-Effects Model is not a good fitre_lmer <-lmer(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1| id),data = dfe)check_predictions(re_lmer)
Family: c("PO", "Poisson")
Fitting method: "nlminb"
Call: gamlssML(formula = ia_run_count, family = "PO", data = dfe)
Mu Coefficients:
[1] 0.623
Degrees of Freedom for the fit: 1 Residual Deg. of Freedom 663
Global Deviance: 2142.06
AIC: 2144.06
SBC: 2148.56
re_m0 <-glmer(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1|id), family = poisson, data = dfe)re_m1 <-glmmTMB(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =genpois(link ="log"), data = dfe)re_m2 <-glmmTMB(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =compois(link ="log"), data = dfe)re_m3 <-glmmTMB(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =nbinom2(link ="log"), data = dfe)re_m4 <-glmmTMB(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =nbinom1(link ="log"), data = dfe)compare_performance(re_m0, re_m1, re_m2, re_m3, re_m4, rank=T) # re_m1 with is the best model
# Distribution by conditionggplot(dfp, aes(x = ia_run_count)) +geom_histogram(aes(y =after_stat(density)), position ="identity", bins =20, fill ="lightblue") +geom_boxplot(aes(y =0), width =0.1) +facet_wrap(~ emoji_color + profile_pic, scales ="free_y") +theme_minimal()
# Remove outliers## Identify values less than mean - 2*SD or greater than mean + 2*SDre_mean_val <-mean(dfp$ia_run_count, na.rm =TRUE)re_std_dev <-sd(dfp$ia_run_count, na.rm =TRUE)re_outliers <-which(dfp$ia_run_count < (re_mean_val -2* re_std_dev) | dfp$ia_run_count > (re_mean_val +2* re_std_dev))length(re_outliers)
[1] 13
dfp$ia_run_count[re_outliers]
[1] 18 10 9 9 9 8 13 10 19 13 47 10 8
## Recode outliers as NAsum(!is.na(dfp$ia_run_count)) # total of data points
[1] 684
dfp$ia_run_count[re_outliers] <-NAsum(!is.na(dfp$ia_run_count)) # total of data points
[1] 671
# ANOVA model fails the assumption of normally distributed residualsanova_model <-aov(ia_run_count ~ profile_pic * emoji_color + emoji_hand_type + texting_usage_s +Error(id),data = dfp)residuals_anova <- anova_model$Within$residualsqqPlot(residuals_anova)
608 528
606 526
Model
# Linear Mixed-Effects Model is not a good fitre_lmer <-lmer(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1| id),data = dfp)check_predictions(re_lmer)
Family: c("PO", "Poisson")
Fitting method: "nlminb"
Call: gamlssML(formula = ia_run_count, family = "PO", data = dfp)
Mu Coefficients:
[1] 0.638
Degrees of Freedom for the fit: 1 Residual Deg. of Freedom 670
Global Deviance: 2478.69
AIC: 2480.69
SBC: 2485.2
# re_m0 <- glmer(ia_run_count ~ 1 + emoji_color * profile_pic + emoji_hand_type + (1|id), # family = poisson, # data = dfp) # failed to convergere_m1 <-glmmTMB(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =genpois(link ="log"), data = dfp)re_m2 <-glmmTMB(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =compois(link ="log"), data = dfp)re_m3 <-glmmTMB(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =nbinom2(link ="log"), data = dfp)re_m4 <-glmmTMB(ia_run_count ~1+ emoji_color * profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =nbinom1(link ="log"), data = dfp)compare_performance(re_m1, re_m2, re_m3, re_m4, rank = T) # re_m1 is the best model
Receiver’s Racialized Profile in the Neutral Condition
# Compute index of participant's confident level about receiver's racialized profiledatra$confident_level_r <- datra$receiver_black - datra$receiver_white
# General distributionhist_boxplot(datra$confident_level_r, col ="lightblue", freq = T, density = F)
# Distribution by conditionggplot(datra, aes(x = confident_level_r)) +geom_histogram(aes(y =after_stat(density)), position ="identity", bins =20, fill ="lightblue") +geom_boxplot(aes(y =0), width =0.1) +facet_wrap(~ emoji_color + profile_pic, scales ="free_y") +theme_minimal()
## Transform data so zero, which is the focus, is 1, and non-zero is 0.datra$confident_level_r_zero <-ifelse(datra$confident_level_r ==0, 1, 0)table(datra$confident_level_r_zero)
0 1
49 179
## Run binomial modelreceiver_racialized_model_zero <-glmer(confident_level_r_zero ~ emoji_color + emoji_hand_type + texting_usage_s + (1|id), data = datra, family ="binomial")# Check effectsAnova(receiver_racialized_model_zero)
# Check quality of the modelrr_check <-simulateResiduals(receiver_racialized_model_zero, plot = T)plot(rr_check)
# Transform data so only non-zero are includeddatra$confident_level_r_nonzero <-ifelse(datra$confident_level_r ==0, NA, datra$confident_level_r)table(datra$confident_level_r_nonzero)
-6 -4 -3 -2 -1 1 2 3 4 6
4 12 5 11 4 1 6 2 2 2
# Run modelreceiver_racialized_model_nonzero <-lmer(confident_level_r_nonzero ~ emoji_color + emoji_hand_type + texting_usage_s + (1|id), data = datra)# Check effectsAnova(receiver_racialized_model_nonzero, type ="2") # emoji_color is significant
# Check if all levels of emoji colors are different from 0# Subset the data for each level of emoji_colordata_dark <- datra$confident_level_r_nonzero[datra$emoji_color =="dark"]data_light <- datra$confident_level_r_nonzero[datra$emoji_color =="light"]data_yellow <- datra$confident_level_r_nonzero[datra$emoji_color =="yellow"]# Run the Anderson-Darling test for normalityad.test(data_dark)
Anderson-Darling normality test
data: data_dark
A = 0.90082, p-value = 0.01734
ad.test(data_light)
Anderson-Darling normality test
data: data_light
A = 0.72381, p-value = 0.04522
ad.test(data_yellow)
Anderson-Darling normality test
data: data_yellow
A = 0.61496, p-value = 0.08893
# Perform Wilcoxon signed-rank test for each subset against 0# Note: Using paired = FALSE for one-sample scenariotest_dark <-wilcox.test(data_dark, mu =0, paired =FALSE, exact =FALSE)test_light <-wilcox.test(data_light, mu =0, paired =FALSE, exact =FALSE)test_yellow <-wilcox.test(data_yellow, mu =0, paired =FALSE, exact =FALSE)de <-c(test_dark$p.value, test_light$p.value, test_yellow$p.value)fdrs <-p.adjust(de, method ="BH")fdrs
# General distributionhist_boxplot(dfp$rt_key_conversation, col ="lightblue", freq = T, density = F)
# Distribution by conditionggplot(dfp, aes(x = rt_key_conversation)) +geom_histogram(aes(y =after_stat(density)), position ="identity", bins =20, fill ="lightblue") +geom_boxplot(aes(y =0), width =0.1) +facet_wrap(~ emoji_color + profile_pic, scales ="free_y") +theme_minimal()
## Base model without interactionreading_base <-glmmTMB(rt_key_conversation ~1+ emoji_color + profile_pic + emoji_hand_type + texting_usage_s + (1|id),family =Gamma(link ="log"), data = dfp)## Check effectsAnova(reading_base, type ="2")
# General distributionhist_boxplot(dfp$rt_sender_white, col ="lightblue", freq = T, density = F)
# Distribution by conditionggplot(dfp, aes(x = rt_sender_white)) +geom_histogram(aes(y =after_stat(density)), position ="identity", bins =20, fill ="lightblue") +geom_boxplot(aes(y =0), width =0.1) +facet_wrap(~ emoji_color + profile_pic, scales ="free_y") +theme_minimal()
## Base model without interactionreact_w_base <-glmmTMB(rt_sender_white ~1+ emoji_color + emoji_hand_type + texting_usage_s + (1|id),family =Gamma(link ="log"), data = dfp)## Check effectsAnova(react_w_base, type ="2")